Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH14/SRC/PARALLEL.FRM

Visual Basic Form | 1996-05-02 | 9.0 KB | 305 lines

VERSION 4.00
Begin VB.Form ParallelForm
   Appearance      =   0  'Flat
   BackColor       =   &H00C0C0C0&
   Caption         =   "Parallel"
   ClientHeight    =   5310
   ClientLeft      =   1410
   ClientTop       =   855
   ClientWidth     =   6870
   BeginProperty Font
      name            =   "MS Sans Serif"
      charset         =   1
      weight          =   700
      size            =   8.25
      underline       =   0   'False
      italic          =   0   'False
      strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000008&
   Height          =   6000
   KeyPreview      =   -1  'True
   Left            =   1350
   LinkTopic       =   "Form1"
   ScaleHeight     =   5310
   ScaleWidth      =   6870
   Top             =   225
   Width           =   6990
   Begin VB.Frame Frame1
      Caption         =   "Rotations"
      Height          =   2415
      Left            =   5400
      TabIndex        =   1
      Top             =   0
      Width           =   1455
      Begin VB.TextBox XYText
         Height          =   285
         Left            =   600
         MaxLength       =   6
         TabIndex        =   10
         Text            =   "0.1"
         Top             =   1320
         Width           =   735
      End
      Begin VB.TextBox XZText
         Height          =   285
         Left            =   600
         MaxLength       =   6
         TabIndex        =   9
         Text            =   "0.2"
         Top             =   1680
         Width           =   735
      End
      Begin VB.TextBox YZText
         Height          =   285
         Left            =   600
         MaxLength       =   6
         TabIndex        =   8
         Text            =   "0.3"
         Top             =   2040
         Width           =   735
      End
      Begin VB.TextBox XWText
         Height          =   285
         Left            =   600
         MaxLength       =   6
         TabIndex        =   4
         Text            =   "0.5"
         Top             =   240
         Width           =   735
      End
      Begin VB.TextBox YWText
         Height          =   285
         Left            =   600
         MaxLength       =   6
         TabIndex        =   3
         Text            =   "0.4"
         Top             =   600
         Width           =   735
      End
      Begin VB.TextBox ZWText
         Height          =   285
         Left            =   600
         MaxLength       =   6
         TabIndex        =   2
         Text            =   "0.0"
         Top             =   960
         Width           =   735
      End
      Begin VB.Label Label1
         Caption         =   "XY"
         Height          =   255
         Index           =   5
         Left            =   240
         TabIndex        =   13
         Top             =   1320
         Width           =   375
      End
      Begin VB.Label Label1
         Caption         =   "XZ"
         Height          =   255
         Index           =   4
         Left            =   240
         TabIndex        =   12
         Top             =   1680
         Width           =   375
      End
      Begin VB.Label Label1
         Caption         =   "YZ"
         Height          =   255
         Index           =   3
         Left            =   240
         TabIndex        =   11
         Top             =   2040
         Width           =   375
      End
      Begin VB.Label Label1
         Caption         =   "XW"
         Height          =   255
         Index           =   0
         Left            =   240
         TabIndex        =   7
         Top             =   240
         Width           =   375
      End
      Begin VB.Label Label1
         Caption         =   "YW"
         Height          =   255
         Index           =   1
         Left            =   240
         TabIndex        =   6
         Top             =   600
         Width           =   375
      End
      Begin VB.Label Label1
         Caption         =   "ZW"
         Height          =   255
         Index           =   2
         Left            =   240
         TabIndex        =   5
         Top             =   960
         Width           =   375
      End
   End
   Begin VB.PictureBox Pict
      AutoRedraw      =   -1  'True
      Height          =   5295
      Left            =   0
      ScaleHeight     =   349
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   349
      TabIndex        =   0
      Top             =   0
      Width           =   5295
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
Attribute VB_Name = "ParallelForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
' Location of focus point.
Const FocusX = 0#
Const FocusY = 0#
Const FocusZ = 0#
Dim ThePicture As ObjPicture
' *******************************************************
' Draw the surface.
' *******************************************************
Private Sub DrawData(pic As Object)
Dim xw_rot As Single
Dim yw_rot As Single
Dim zw_rot As Single
Dim xy_rot As Single
Dim xz_rot As Single
Dim yz_rot As Single
Dim XW(1 To 5, 1 To 5) As Single
Dim YW(1 To 5, 1 To 5) As Single
Dim ZW(1 To 5, 1 To 5) As Single
Dim XY(1 To 5, 1 To 5) As Single
Dim XZ(1 To 5, 1 To 5) As Single
Dim YZ(1 To 5, 1 To 5) As Single
Dim S(1 To 5, 1 To 5) As Single
Dim T(1 To 5, 1 To 5) As Single
Dim M12(1 To 5, 1 To 5) As Single
Dim M34(1 To 5, 1 To 5) As Single
Dim M1_4(1 To 5, 1 To 5) As Single
Dim M56(1 To 5, 1 To 5) As Single
Dim M78(1 To 5, 1 To 5) As Single
Dim M5_8(1 To 5, 1 To 5) As Single
Dim M1_8(1 To 5, 1 To 5) As Single
    If Not IsNumeric(XWText.Text) Then Exit Sub
    If Not IsNumeric(YWText.Text) Then Exit Sub
    If Not IsNumeric(ZWText.Text) Then Exit Sub
    If Not IsNumeric(XYText.Text) Then Exit Sub
    If Not IsNumeric(XZText.Text) Then Exit Sub
    If Not IsNumeric(YZText.Text) Then Exit Sub
    xw_rot = CSng(XWText.Text)
    yw_rot = CSng(YWText.Text)
    zw_rot = CSng(ZWText.Text)
    xy_rot = CSng(XYText.Text)
    xz_rot = CSng(XZText.Text)
    yz_rot = CSng(YZText.Text)
    MousePointer = vbHourglass
    Refresh
    ' Prevent overflow errors when drawing lines
    ' too far out of bounds.
    On Error Resume Next
    ' Calculate the rotation matrices.
    m4XWRotate XW, xw_rot
    m4YWRotate YW, yw_rot
    m4ZWRotate ZW, zw_rot
    m4XYRotate XY, xy_rot
    m4XZRotate XZ, xz_rot
    m4YZRotate YZ, yz_rot
    ' Scale and translate so it looks OK in pixels.
    m4Scale S, 75, -75, 1, 1
    m4Translate T, Pict.ScaleWidth / 2, Pict.ScaleHeight / 2, 0, 0
    m4MatMultiply M12, XW, YW
    m4MatMultiply M34, ZW, XY
    m4MatMultiply M56, XZ, YZ
    m4MatMultiply M78, S, T
    m4MatMultiply M1_4, M12, M34
    m4MatMultiply M5_8, M56, M78
    m4MatMultiply M1_8, M1_4, M5_8
    ' Transform the points.
    ThePicture.Apply M1_8
    ' Display the data.
    pic.Cls
    ThePicture.Draw pic
    pic.Refresh
    MousePointer = vbDefault
End Sub
Private Sub Form_Load()
    ' Create the data.
    CreateData
    ' Project and draw the data.
    Me.Show
    DrawData Pict
End Sub
' ************************************************
' Create the surface.
' ************************************************
Sub CreateData()
Dim pline As ObjPolyline4D
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim w As Integer
    MousePointer = vbHourglass
    Refresh
    Set ThePicture = New ObjPicture
    Set pline = New ObjPolyline4D
    ThePicture.objects.Add pline
    For x = -1 To 1 Step 2
        For y = -1 To 1 Step 2
            For z = -1 To 1 Step 2
                For w = -1 To 1 Step 2
                    If x = -1 Then _
                        pline.AddSegment _
                            x, y, z, w, _
                            1, y, z, w
                    If y = -1 Then _
                        pline.AddSegment _
                            x, y, z, w, _
                            x, 1, z, w
                    If z = -1 Then _
                        pline.AddSegment _
                            x, y, z, w, _
                            x, y, 1, w
                    If w = -1 Then _
                        pline.AddSegment _
                            x, y, z, w, _
                            x, y, z, 1
                Next w
            Next z
        Next y
    Next x
    MousePointer = vbDefault
End Sub
Private Sub mnuFileExit_Click()
    Unload Me
End Sub
Private Sub XYText_Change()
    DrawData Pict
End Sub
Private Sub XZText_Change()
    DrawData Pict
End Sub
Private Sub YWText_Change()
    DrawData Pict
End Sub
Private Sub YZText_Change()
    DrawData Pict
End Sub
Private Sub ZWText_Change()
    DrawData Pict
End Sub
Private Sub XWText_Change()
    DrawData Pict
End Sub